home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / msdos / 4utils80.zip / 4FF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-17  |  15KB  |  443 lines
  1. PROGRAM FileFind;
  2. {$A+,B-,D-,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X-}
  3. {$M 16384,0,65530}
  4. (* ----------------------------------------------------------------------
  5.    A 4DOS-aware file finder. It searches in .LZH archives too.
  6.  
  7.    (c) 1992, 1993 Copyright by David Frey,
  8.                                Urdorferstrasse 30
  9.                                8952 Schlieren ZH
  10.                                Switzerland
  11.  
  12.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  13.  
  14.    DISCLAIMER:   This program is freeware: you are allowed to use, copy
  15.                  and change it free of charge, but you may not sell or hire
  16.                  4FF. The copyright remains in my hands.
  17.  
  18.                  If you make any (considerable) changes to the source code,
  19.                  please let me know. (send me a copy or a listing).
  20.                  I would like to see what you have done.
  21.  
  22.                  I, David Frey, the author, provide absolutely no warranty of
  23.                  any kind. The user of this software takes the entire risk of
  24.                  damages, failures, data losses or other incidents.
  25.  
  26.    NOTES:        Turbo Pascal 6.0 required for compiling. (sorry, but I'm
  27.                  using FormatStr for output)
  28.  
  29.    ENHANCEMENTS: adapted to 4DOS 4.01 - when redirecting into files,
  30.                  full descriptions will be shown, otherwise the
  31.                  descriptions will be truncated at the right screen margin.
  32.  
  33.                  paging switch (/p) added.
  34.                  Fast screen output when no redirected output has been used.
  35.  
  36.                  Searches for Read Only / Hidden directories, too.
  37.  
  38.                  ARJ File scanning added.
  39.  
  40.                  Supports now 4DOS 5.0, i.e. 200 characters description
  41.                  length.
  42.  
  43.    ----------------------------------------------------------------------- *)
  44.  
  45. USES {$IFOPT G+} Test286, {$ENDIF}
  46.      Fix, Crt, Dos, Objects, Drivers,
  47.      StringDateHandling, HandleINIFile,
  48.      ScanLZHFiles, ScanZIPFiles, ScanARJFiles, Globals;
  49.  
  50. CONST Header= '4FF 4DOS File Find 1.8 -- (c) David Frey 1992, 1993';
  51.  
  52. VAR   DescBuffer: ARRAY[0..512] OF CHAR;
  53.  
  54. VAR   ActDir, StartDir            : STRING;
  55.  
  56.       DescArray                   : DescArrayType;
  57.       FileSpecArray               : FileSpecArrayType;
  58.  
  59.       DescFile                    : TEXT;
  60.       DescLine                    : STRING;
  61.       DescLineNr                  : WORD;
  62.       Desc                        : DescStr;
  63.       DescStart                   : BYTE;
  64.       DescEnd                     : BYTE;
  65.       DescFound                   : BOOLEAN;
  66.  
  67.       i,l                         : WORD;
  68.       k                           : BYTE;
  69.       FileSpecs                   : BYTE;
  70.       ps,fs                       : STRING;
  71.       IORes                       : INTEGER;
  72.  
  73.       Templ                       : STRING;
  74.  
  75.       OldCtrlBreakHandler         : POINTER;
  76.       OldCtrlBreakState           : BOOLEAN;
  77.       BrokeOut                    : BOOLEAN;
  78.  
  79. PROCEDURE MyCtrlBreakHandler; FAR;
  80.  
  81. BEGIN
  82.  ExitProc := OldCtrlBreakHandler; SetCBreak(OldCtrlBreakState);
  83.  {$I-}
  84.  ChDir(ActDir); IORes := IOResult;
  85.  IF BrokeOut THEN
  86.   BEGIN
  87.    WriteLn(Output);
  88.    WriteLn(Output,' EXITING - User broke out of program.');
  89.    WriteLn(Output);
  90.   END;
  91.  Close(Output);
  92.  IF NOT Redirected THEN NormVideo;
  93. END;
  94.  
  95. PROCEDURE ShowFileData(VAR search: SearchRec;VAR Path: PathStr;VAR Desc: DescStr);
  96.  
  97. VAR i       : INTEGER;
  98.  
  99. BEGIN
  100.  IF BareOutput THEN
  101.   Write(Output,Path,Search.Name,' ')
  102.  ELSE
  103.   BEGIN
  104.    IF FileCount = 0 THEN
  105.     BEGIN
  106.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  107.      WriteLn(Output,Path); IF DoPage THEN TestForMoreMsg;
  108.     END;
  109.  
  110.    InfoArray[0] := LONGINT(@search.Name);
  111.  
  112.    SizeStr := FormattedLongIntStr(search.Size,7);
  113.    InfoArray[1] := LONGINT(@SizeStr);
  114.  
  115.    UnpackTime(search.Time,DateRec);
  116.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  117.    InfoArray[2] := LONGINT(@Date);
  118.    InfoArray[3] := LONGINT(@Time);
  119.  
  120.    AttrStr := '....';
  121.    IF search.Attr AND ReadOnly = ReadOnly THEN AttrStr[1] := 'r';
  122.    IF search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  123.    IF search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  124.    IF search.Attr AND Archive  = Archive  THEN AttrStr[4] := 'a';
  125.    InfoArray[4] := LONGINT(@AttrStr);
  126.    InfoArray[5] := LONGINT(@Desc);
  127.  
  128.    FormatStr(s,'%-12s    %8s '+DateTempl+' '+TimeTempl+' %4s '+DescTempl,InfoArray);
  129.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  130.  
  131.    INC(TotalSize,Search.Size); INC(DirSize,Search.Size);
  132.    INC(TotalFileCount); INC(FileCount);
  133.   END;
  134. END; (* ShowFileData *)
  135.  
  136. PROCEDURE BuildList(Dir: DirStr; VAR FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  137.                     Attr: BYTE);
  138.  
  139. VAR Search: SearchRec;
  140.     DescFileExists: BOOLEAN;
  141.     l,i,k         : BYTE;
  142.  
  143. BEGIN (* BuildList *)
  144.  FileCount := 0; DirSize := 0;
  145.  Attr := Attr AND NOT Directory AND NOT VolumeId;
  146.  OldLHFileName := ''; OldZipFileName := '';
  147.  
  148.  l := Length(Dir); s := Dir;
  149.  IF (l>3) AND (s[l] = '\') THEN Delete(s,l,1);
  150.  ChDir(s);
  151.  
  152.  {$I-}
  153.  Assign(DescFile,'DESCRIPT.ION'); SetTextBuf(DescFile,DescBuffer);
  154.  Reset(DescFile);
  155.  DescFileExists := (IOResult = 0);
  156.  IF DescFileExists THEN
  157.   BEGIN
  158.    DescLineNr := 1;
  159.    WHILE NOT Eof(DescFile) AND (DescLineNr <= MaxComments) DO
  160.     BEGIN
  161.      ReadLn(DescFile,DescLine); DescStart := Pos(' ',DescLine);
  162.      DescEnd := Pos(#4,DescLine); IF DescEnd = 0 THEN DescEnd := Length(DescLine)+1;
  163.      Desc := Copy(DescLine,DescStart+1,DescEnd-1);
  164.      StripLeadingSpaces(Desc);
  165.      i := 1; l := Length(DescLine);
  166.      REPEAT
  167.       IF (DescLine[i] >= 'A') AND (DescLine[i] <= 'Z') THEN
  168.        BEGIN DescLine[i] := Char(Ord(DescLine[i])+32); END;
  169.       INC(i);
  170.      UNTIL (i=l) OR (DescLine[i] = ' ');
  171.      DescArray[DescLineNr] := DescLine; INC(DescLineNr);
  172.     END;
  173.    DEC(DescLineNr);
  174.    IF DescLineNr = MaxComments THEN
  175.     BEGIN
  176.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  177.      WriteLn(Output,'WARNING: description line buffer full, some comments may not appear.'); IF DoPage THEN TestForMoreMsg;
  178.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  179.     END;
  180.    {$I-}
  181.    Close(DescFile); IORes := IOResult;
  182.   END;
  183.  
  184.  IF DoScanLZHArchives THEN
  185.   BEGIN
  186.    FindFirst('????????.LZH',ReadOnly+Archive,Search);
  187.    WHILE DosError = 0 DO
  188.     BEGIN
  189.      SearchInLZHFile(FileSpec,FileSpecs,Dir,Search);
  190.      FindNext(Search);
  191.     END;
  192.   END;
  193.  IF DoScanZIPArchives THEN
  194.   BEGIN
  195.    FindFirst('????????.ZIP',ReadOnly+Archive,Search);
  196.    WHILE DosError = 0 DO
  197.     BEGIN
  198.      SearchInZIPFile(FileSpec,FileSpecs,Dir,Search);
  199.      FindNext(Search);
  200.     END;
  201.   END;
  202.  IF DoScanARJArchives THEN
  203.   BEGIN
  204.    FindFirst('????????.ARJ',ReadOnly+Archive,Search);
  205.    WHILE DosError = 0 DO
  206.     BEGIN
  207.      SearchInARJFile(FileSpec,FileSpecs,Dir,Search);
  208.      FindNext(Search);
  209.     END;
  210.   END;
  211.  
  212.  FOR k := 1 TO FileSpecs DO
  213.   BEGIN
  214.    FindFirst(FileSpec[k], Attr, Search);
  215.    WHILE DosError = 0 DO
  216.     BEGIN
  217.      IF NOT ExactAttr OR (ExactAttr AND (Search.Attr = Attr)) THEN
  218.       BEGIN
  219.        DownString(Search.Name);
  220.        Desc := '';
  221.        IF (NOT DescFileExists OR (Search.Name = 'descript.ion')) THEN
  222.         ShowFileData(search,Dir,Desc)
  223.        ELSE
  224.         BEGIN
  225.          i := 1;
  226.          REPEAT
  227.           DescStart := Pos(' ',DescArray[i]);
  228.           DescFound := (Copy(DescArray[i],1,DescStart-1) = Search.Name);
  229.           IF NOT DescFound THEN INC(i);
  230.          UNTIL  DescFound OR (i>DescLineNr);
  231.          IF NOT DescFound THEN Desc := ''
  232.                           ELSE Desc := Copy(DescArray[i],DescStart+1,255);
  233.          ShowFileData(search,Dir,Desc);
  234.         END;
  235.       END;
  236.      FindNext(Search);
  237.     END;
  238.   END;
  239.  
  240.  IF NOT BareOutput AND (FileCount > 0) THEN
  241.   BEGIN
  242.    Templ := '%-4s entr';
  243.    IF FileCount = 1 THEN Templ := Templ + 'y,  '
  244.                     ELSE Templ := Templ + 'ies,';
  245.    Templ := Templ+' %10s Bytes';
  246.  
  247.    FileStr := FormattedIntStr(FileCount,4);  InfoArray[0] := LONGINT(@FileStr);
  248.    SizeStr := FormattedLongIntStr(DirSize,10);InfoArray[1] := LONGINT(@SizeStr);
  249.    FormatStr(s,Templ,InfoArray);
  250.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  251.   END;
  252.  
  253.  FindFirst('????????. ',Directory+ReadOnly+Hidden,Search);
  254.  WHILE DosError = 0 DO
  255.   BEGIN
  256.    IF (Search.Attr = Directory) AND
  257.       (Search.Name <> '.') AND (Search.Name <> '..') THEN
  258.     BuildList(Dir+Search.Name+'\',FileSpec,FileSpecs,Attr);
  259.    FindNext(Search);
  260.   END;
  261.  {$I-}
  262.  ChDir('..'); IORes := IOResult;
  263. END; (* BuildList *)
  264.  
  265.  
  266. FUNCTION DriveValid(C: CHAR): BOOLEAN; ASSEMBLER;
  267. ASM
  268.   MOV   DL,C
  269.   MOV   AH,36H
  270.   SUB   DL,'A'-1
  271.   Int   21H
  272.   INC   AX
  273.   JE    @@2
  274. @@1:
  275.   MOV   AL,1
  276. @@2:
  277. END; (* DriveValid *)
  278.  
  279. PROCEDURE GiveHelp;
  280.  
  281. BEGIN
  282.  WriteLn(Output);
  283.  WriteLn(Output,Header);
  284.  WriteLn(Output);
  285.  WriteLn(Output,'This program is freeware: you are allowed to use, copy it free');
  286.  WriteLn(Output,'of charge, but you may not sell or hire 4FF.');
  287.  WriteLn(Output);
  288.  WriteLn(Output,'usage: 4FF [/a:[-]rash][/l][/z][/s][/b][/d][/m:nn][/?] [start dir\]{filenames}');
  289.  WriteLn(Output);
  290.  WriteLn(Output,' /a:rash search for files with these attributes set.');
  291.  WriteLn(Output,' /l      do not search in .lzh archive files.');
  292.  WriteLn(Output,' /z      do not search in .zip archive files.');
  293.  WriteLn(Output,' /j      do not search in .arj archive files.');
  294.  WriteLn(Output,' /s      scan only subdirectories of given path `start-dir''');
  295.  WriteLn(Output,' /b      bare listing (omits size, date, and descriptions)');
  296.  WriteLn(Output,' /d      scan all hard disks (address floppy drives explicitely)');
  297.  WriteLn(Output,' /m:nn   set right margin to nn');
  298.  WriteLn(Output,' /p      page output');
  299.  WriteLn(Output,' /?      this help display.');
  300.  HALT;
  301. END; (* GiveHelp *)
  302.  
  303. BEGIN
  304.  GetCBreak(OldCtrlBreakState); SetCBreak(FALSE);
  305.  OldCtrlBreakHandler := ExitProc; ExitProc := @MyCtrlBreakHandler;
  306.  BrokeOut := FALSE;
  307.  
  308.  GetDir(0,ActDir);
  309.  
  310.  IF (ParamStr(1) = '/?') OR (ParamStr(1) = '-?') THEN GiveHelp;
  311.  
  312.  IF TextRec(Output).Name[0] <> #0 THEN
  313.   BEGIN
  314.    Str(DescLen,DescTempl); DescTempl := '%-'+DescTempl+'s';
  315.   END;
  316.  
  317.  BareOutput     := FALSE; ExactAttr  := FALSE;
  318.  SubDirectories := FALSE; AllDrives  := FALSE;
  319.  DoScanLZHArchives := TRUE; DoScanZIPArchives := TRUE;
  320.  DoScanARJArchives := TRUE;
  321.  FileSpecArray[1] := '*.*'; FileSpecs := 1; StartDir := '';
  322.  
  323.  i := 1; l := 0;
  324.  REPEAT
  325.   ps := ParamStr(i);
  326.   IF ps[1] = '/' THEN ps[1] := '-';
  327.   IF ps[1] = '-' THEN
  328.    BEGIN
  329.     s := Copy(ps,2,255); DownString(s);
  330.  
  331.     IF DoScanLZHArchives     THEN DoScanLZHArchives := (s <>'l');
  332.     IF DoScanZIPArchives     THEN DoScanZIPArchives := (s <>'z');
  333.     IF DoScanARJArchives     THEN DoScanARJArchives := (s <>'j');
  334.     IF NOT SubDirectories    THEN SubDirectories    := (s='s');
  335.     IF NOT BareOutput        THEN BareOutput        := (s='b');
  336.     IF NOT AllDrives         THEN AllDrives         := (s='d');
  337.     IF NOT DoPage AND NOT Redirected THEN DoPage    := (s='p');
  338.  
  339.     IF s[1] = 'a' THEN
  340.      BEGIN
  341.       s := Copy(s,Pos(':',s)+1,255);
  342.       Attr := 0; AttrStr := '....'; ExactAttr := TRUE;
  343.  
  344.       IF (Pos('r',s) > 0) AND (Pos('-r',s) = 0) THEN BEGIN INC(Attr,ReadOnly); AttrStr[1] := 'r'; END;
  345.       IF (Pos('h',s) > 0) AND (Pos('-h',s) = 0) THEN BEGIN INC(Attr,Hidden  ); AttrStr[2] := 'h'; END;
  346.       IF (Pos('s',s) > 0) AND (Pos('-s',s) = 0) THEN BEGIN INC(Attr,SysFile ); AttrStr[3] := 's'; END;
  347.       IF (Pos('a',s) > 0) AND (Pos('-a',s) = 0) THEN BEGIN INC(Attr,Archive ); AttrStr[4] := 'a'; END;
  348.      END;
  349.  
  350.     IF ps[2] = 'm' THEN
  351.      BEGIN
  352.       Delete(ps,1,3); Val(ps,k,IORes);
  353.       MaxViewLength := k-31-Length(DateFormat)-Length(TimeFormat);
  354.       Str(MaxViewLength,DescTempl); DescTempl := '%-'+DescTempl+'s';
  355.      END;
  356.     INC(l);
  357.    END;
  358.    INC(i);
  359.   UNTIL (i>ParamCount) OR (ps[1] <> '-');
  360.  
  361.  IF l < ParamCount THEN
  362.   BEGIN
  363.    FOR i := l+1 TO ParamCount DO
  364.     BEGIN
  365.      FSplit(FExpand(ParamStr(i)),Path,Name,Ext);
  366.      IF (Path <> '') AND (StartDir = '') THEN StartDir := Path;
  367.      IF Name = '' THEN Name := '*';
  368.      IF Ext  = '' THEN Ext  := '.*';
  369.  
  370.      FileSpecArray[i-l] := Name+Ext; DownString(FileSpecArray[i-l]);
  371.     END;
  372.     FileSpecs := ParamCount-l;
  373.   END;
  374.  
  375.  IF StartDir = ''  THEN StartDir := ActDir;
  376.  IF SubDirectories THEN Path := StartDir
  377.                    ELSE Path := Copy(StartDir,1,3);
  378.  
  379.  IF NOT BareOutput THEN
  380.   BEGIN
  381.    WriteLn(Output,Header);
  382.    WriteLn(Output);
  383.    WriteLn(Output,'This program is freeware: you are allowed to use,');
  384.    WriteLn(Output,'copy it free of charge, but you may not sell or hire 4FF.');
  385.    WriteLn(Output);
  386.    IF FileSpecs = 1 THEN WriteLn(Output,'Filename  = ',FileSpecArray[1],'.')
  387.    ELSE
  388.     BEGIN
  389.      Write(Output, 'Filenames = ');
  390.      FOR i := 1 TO FileSpecs DO
  391.       BEGIN
  392.        Write(Output,FileSpecArray[i]);
  393.        IF i < FileSpecs THEN Write(Output,', ')
  394.                         ELSE WriteLn(Output,'.');
  395.       END;
  396.     END;
  397.    IF AllDrives THEN WriteLn(Output,'Scanning all drives.')
  398.                 ELSE WriteLn(Output,'Path      = ',Path);
  399.    Line := 7;
  400.    IF ExactAttr THEN
  401.     BEGIN
  402.      WriteLn(Output,'Attributes= ',AttrStr); INC(Line);
  403.     END;
  404.   END;
  405.  
  406.  IF DoScanLZHArchives OR DoScanZIPArchives OR DoScanARJArchives THEN InstallBuffer;
  407.  
  408.  TotalFileCount := 0; TotalSize := 0; BrokeOut := TRUE;
  409.  
  410.  IF NOT AllDrives THEN
  411.   BEGIN
  412.    s := Path; l := Length(s);
  413.    IF (l > 3) AND (s[l] = '\') THEN Delete(s,l,1);
  414.    BuildList(Path,FileSpecArray,FileSpecs,Attr)
  415.   END
  416.  ELSE
  417.   FOR Drive := 'C' TO 'Z' DO
  418.    IF DriveValid(Drive) THEN BuildList(Drive+':\',FileSpecArray,FileSpecs,Attr);
  419.  BrokeOut := FALSE;
  420.  
  421.  IF NOT BareOutput THEN
  422.   BEGIN
  423.    IF TotalFileCount = 0 THEN s := 'no files found.'
  424.    ELSE
  425.     BEGIN
  426.      Templ := '%s file';
  427.      IF TotalFileCount = 1 THEN Templ := Templ +', '
  428.                            ELSE Templ := Templ +'s,';
  429.      Templ := Templ+'   %10s Bytes';
  430.  
  431.      FileStr := FormattedIntStr(TotalFileCount,4); InfoArray[0] := LONGINT(@FileStr);
  432.      SizeStr := FormattedLongIntStr(TotalSize,10); InfoArray[1] := LONGINT(@SizeStr);
  433.      FormatStr(s,Templ,InfoArray);
  434.     END;
  435.  
  436.    WriteLn(Output,'------------------------------------------------'); IF DoPage THEN TestForMoreMsg;
  437.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  438.   END
  439.  ELSE WriteLn(Output);
  440.  
  441.  IF DoScanLZHArchives OR DoScanZIPArchives OR DoScanARJArchives THEN FreeBuffer;
  442. END.
  443.